home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok41 / spiele / mastermind / txt / benutzereingabe.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  161 lines
  1. (*********************************************************************
  2.  *
  3.  *  :Program.        EingabeModul für BESTENLISTE
  4.  *  :Author.        Hans Schafft
  5.  *  :Address.        Landfriedstraße 1A - Hinterhaus
  6.  *  :Address.        6900 Heidelberg
  7.  *  :Phone.        06221 - 22416
  8.  *  :Version.        1.3
  9.  *  :Date.        6/1990
  10.  *  :Copyright.        PD
  11.  *  :Language.        Modula-II
  12.  *  :Translator.    M2Amiga
  13.  *  :Contents.
  14.  *
  15.  *********************************************************************)
  16. (***************************************************************)
  17. (* Das Modul überschreibt einen String mit der BenutzerEingabe *)
  18. (***************************************************************)
  19. IMPLEMENTATION MODULE BenutzerEingabe;
  20.  
  21. FROM Arts    IMPORT    Assert;
  22. FROM SYSTEM    IMPORT    ADDRESS, LONGSET, ADR;
  23. FROM Graphics    IMPORT    jam2, jam1, SetAPen, RectFill,ScrollRaster,
  24.             ClipBlit,WaitTOF;
  25. FROM Str     IMPORT    Concat,Copy;
  26. FROM Exec          IMPORT  WaitPort,ReplyMsg,GetMsg;
  27. FROM Intuition    IMPORT    strGadget,ActivationFlagSet,Border,Gadget,AddGadget,
  28.             GadgetPtr,IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet,
  29.             GadgetFlagSet,IntuiText,RemoveGadget,ActivateGadget,
  30.             ActivationFlags, WindowPtr,RefreshGadgets,StringInfo;
  31.  
  32. (***************************************************************)
  33. PROCEDURE Eingabe(wiPtr : WindowPtr; VAR name : ARRAY OF CHAR);
  34.  
  35. CONST
  36.  GadBreite  =  160;
  37.  GadHoehe   =  12;
  38.  XPos = 130;
  39.  YPos = 490;
  40.  
  41. VAR
  42.  NameGad    : Gadget;
  43.  NameGadBorder    : Border;
  44.  NameGadPairs    : ARRAY [1..10] OF INTEGER;
  45.  NameStrInfo    : StringInfo;
  46.  itext        : IntuiText;
  47.  ok        : BOOLEAN;
  48.  buffer        : ARRAY [0..21] OF CHAR;
  49.  bufPtr        : ADDRESS;
  50.  pos        : INTEGER;
  51.  hilfen,y    : INTEGER;
  52.  versuche,x    : INTEGER;
  53.  msgPtr        : IntuiMessagePtr;
  54.  class        : IDCMPFlagSet;
  55.  gadPtr        : GadgetPtr;
  56.  
  57. BEGIN
  58.   FOR pos := 0 TO 21 DO
  59.     buffer[pos] := 0C;
  60.   END;
  61.   bufPtr := ADR(buffer[0]);
  62.  
  63.    (* Koordinaten für den Rand der Gadget Box *)
  64.   NameGadPairs[1] := 0;              NameGadPairs[2] := 0;
  65.   NameGadPairs[3] := GadBreite+1;    NameGadPairs[4] := 0;
  66.   NameGadPairs[5] := GadBreite+1;    NameGadPairs[6] := GadHoehe+1;
  67.   NameGadPairs[7] := 0;              NameGadPairs[8] := GadHoehe+1;
  68.   NameGadPairs[9] := 0;              NameGadPairs[10] := 0;
  69.  
  70.   WITH itext DO
  71.     leftEdge  := 0;            topEdge := -12;
  72.     frontPen  := 1;            backPen := 0;
  73.     drawMode  := jam1;            nextText := NIL;
  74.     iTextFont := NIL;
  75.     iText     := ADR("BITTE NAME EINGEBEN");
  76.   END;
  77.  
  78.   WITH NameGadBorder DO
  79.     leftEdge := -1;             topEdge    := -1;
  80.     frontPen := 3;             backPen    := 2;
  81.     drawMode := jam2;             count        := 5;
  82.     xy          := ADR(NameGadPairs);     nextBorder := NIL;
  83.   END;
  84.  
  85.   WITH NameStrInfo DO
  86.     buffer     := bufPtr;
  87.     undoBuffer     := NIL;
  88.     bufferPos     := 0;
  89.     maxChars     := 20;
  90.     dispPos     := 0;
  91.     undoPos     := 0;
  92.     numChars     := 20;
  93.     dispCount     := 0;
  94.     cLeft     := 0;
  95.     cTop     := 0;
  96.     layerPtr     := NIL;
  97.     longInt     := 0;
  98.     altKeyMap     := NIL;
  99.   END;
  100.  
  101.   WITH NameGad DO
  102.     leftEdge        :=  XPos;
  103.     topEdge        :=  YPos;
  104.     width        :=  GadBreite;
  105.     height      :=  GadHoehe;
  106.     flags        :=  GadgetFlagSet{};
  107.     activation       :=  ActivationFlagSet{relVerify};
  108.     gadgetType       :=  strGadget;
  109.     gadgetRender  :=  ADR(NameGadBorder);
  110.     gadgetText       :=  ADR(itext);
  111.     mutualExclude :=  LONGSET{};
  112.     nextGadget       :=  NIL;
  113.     selectRender  :=  NIL;
  114.     specialInfo   :=  ADR(NameStrInfo);
  115.     userData      :=  NIL;
  116.     gadgetID       :=  200;
  117.   END;
  118.  
  119.   pos := AddGadget(wiPtr,ADR(NameGad),0);
  120.   RefreshGadgets(ADR(NameGad),wiPtr,NIL);
  121.   ok := ActivateGadget(ADR(NameGad),wiPtr,NIL);
  122.   Assert(ok,ADR("Gadget konnte nicht aktiviert werden"));
  123.  
  124.   REPEAT
  125.     WaitPort(wiPtr^.userPort);
  126.     LOOP
  127.       msgPtr := GetMsg(wiPtr^.userPort);
  128.       IF msgPtr = NIL THEN EXIT END;
  129.  
  130.       class := msgPtr^.class;
  131.       gadPtr:= msgPtr^.iAddress;
  132.  
  133.       ReplyMsg(msgPtr);
  134.  
  135.       IF (gadPtr^.gadgetID = 200) THEN
  136.         ok := TRUE;
  137.         EXIT;
  138.       ELSE
  139.         ok := FALSE;
  140.       END;
  141.  
  142.     END; (* LOOP *)
  143.   UNTIL ok;
  144.  
  145.   pos := RemoveGadget(wiPtr,ADR(NameGad));
  146.  
  147.   FOR x := 30 TO 190 DO
  148.     ClipBlit(wiPtr^.rPort,XPos-2,YPos-14,wiPtr^.rPort,
  149.           XPos-(x DIV 2),YPos-14-x,GadBreite+4,GadHoehe+16,0C0H);
  150.   END;
  151.  
  152.   Concat(buffer,0C);
  153.   Copy(name,buffer);
  154.  
  155. END  Eingabe;
  156.  
  157. (***************************************************************)
  158. (***************************************************************)
  159. BEGIN
  160. END BenutzerEingabe.
  161.